home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 22
/
Cream of the Crop 22.iso
/
utility
/
sccan.zip
/
UNIT1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-10
|
10KB
|
337 lines
unit Unit1;
{ SCAN - Table Scanning Utility 1.1 - Main Unit
Copyright (c) 1996 by Martin Kelly, PDQ Technology Limited
All rights reserved.
This software should not be SOLD by anyone other than the author,
Martin Kelly. It is distributed as freeware and therefore may be used
free of charge.
Comments:
Compuserve ID: 100437,2243
Payback:
I have been downloading lots of interesting stuff from the Delphi forums
for months, so I thought it was about time I uploaded something (useful?)
on the basis that giving is apparently more spiritually rewarding than
taking.
Disclaimer:
The author shall have no liability whatsoever in respect of the use of
this program, and nor does the author warrant that the use of this program
will be uninterrupted or error free. }
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, DB, Grids, DBGrids, DBTables, ExtCtrls, Buttons,
DBCtrls, Menus, Unit2, Unit3;
type
TMain = class(TForm)
Table1: TTable;
Table2: TTable;
DBGrid1: TDBGrid;
DBGrid2: TDBGrid;
DataSource1: TDataSource;
DataSource2: TDataSource;
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
BitBtn1: TBitBtn;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
OpenDialog1: TOpenDialog;
DBNavigator1: TDBNavigator;
OpenDialog2: TOpenDialog;
BitBtn2: TBitBtn;
MainMenu1: TMainMenu;
File1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
Contents: TMenuItem;
SpeedHelp: TSpeedButton;
SpeedClose: TSpeedButton;
SelectMastertable1: TMenuItem;
SelecttabletoComparewithMaster1: TMenuItem;
N1: TMenuItem;
Cleartableselections1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Comparethetables1: TMenuItem;
N4: TMenuItem;
About1: TMenuItem;
procedure BitBtn1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure DBGrid1Enter(Sender: TObject);
procedure DBGrid2Enter(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure SpeedCloseClick(Sender: TObject);
procedure SpeedHelpClick(Sender: TObject);
procedure About1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Main: TMain;
implementation
{$R *.DFM}
procedure TMain.BitBtn1Click(Sender: TObject);
var
F: TextFile;
S, Table1PrimIndxStr, Table2PrimIndxStr: String;
I: Integer;
BEGIN
{Check that both datasets are active}
if not Table1.Active or not Table2.Active then
begin
MessageDlg('Table selections are incomplete.', mtError, [mbOk], 0);
Abort;
end;
{Check that the tables have the same number of fields}
if IntToStr(DBGrid1.FieldCount)<>IntToStr(DBGrid2.FieldCount)then
begin
MessageDlg('Tables MUST have the same structure.', mtError, [mbOk], 0);
Abort;
end;
{Ensure that the most recent index information is used}
Table1.IndexDefs.Update;
Table2.IndexDefs.Update;
{Initialize String Variables}
Table1PrimIndxStr := '';
Table2PrimIndxStr := '';
{Try to locate primary index for both tables}
for I := 0 to Table1.IndexDefs.Count - 1 do
{Find primary index}
if (ixPrimary in Table1.IndexDefs.Items[I].Options) then
{Save the field names of the key to String Variable}
Table1PrimIndxStr := Table1.IndexDefs.Items[I].Fields;
for I := 0 to Table2.IndexDefs.Count - 1 do
{Find primary index}
if (ixPrimary in Table2.IndexDefs.Items[I].Options) then
{Save the fields names of the key to String Variable}
Table2PrimIndxStr := Table2.IndexDefs.Items[I].Fields;
{Check for primary index in Table1}
if Table1PrimIndxStr = '' then
begin
MessageDlg(Table1.TableName + ' does not have a Primary Index.',
mtError, [mbOk], 0);
Abort;
end;
{Check for primary index in Table2}
if Table2PrimIndxStr = '' then
begin
MessageDlg(Table2.TableName + ' does not have a Primary Index.',
mtError, [mbOk], 0);
Abort;
end;
{Compare primary index fields found in both tables}
if Table1PrimIndxStr <> Table2PrimIndxStr then
begin
MessageDlg('Primary Index fields in tables do not match.',
mtError, [mbOk], 0);
Abort;
end;
{Prepare the text file}
AssignFile(F, 'SCANLOG.TXT');
Rewrite(F);
Writeln(F, DateTimeToStr(Now));
Writeln(F, '');
Writeln(F, 'Master table: '+ OpenDialog1.FileName);
{Initialize String Variable}
S := '';
{Use TRY..EXCEPT to trap exceptions..}
TRY
with Table1 do
{Create a composite string with the key field names separated by ', '}
for I := 0 to IndexFieldCount - 1 do
S := S + ', ' + IndexFields[I].FieldName;
{Remove initial ', '}
Delete(S,1,2);
Writeln(F, 'Primary index: ' + S);
Writeln (F,'');
Writeln(F, 'Differences identified in '+ OpenDialog2.FileName);
Writeln (F,'');
{Goto first record in Table1}
Table1.First;
While not Table1.EOF do
begin
S := '';
{Put Table2 in SetKey state}
{Note - as no value has been assigned to the IndexName property then
Primary Index is utilised. Delphi always open tables on its
Primary Index.}
Table2.SetKey;
with Table1 do
{Assign Values to be searched for in Table2 using Primary Key}
for I := 0 to IndexFieldCount - 1 do
Table2.Fields[I].AsString := IndexFields[I].AsString;
with Table1 do
{Create a composite string with the key field values separated by ', '}
for I := 0 to IndexFieldCount - 1 do
S := S + ', ' + IndexFields[I].AsString;
{Remove initial ', '}
Delete(S,1,2);
if Table2.GotoKey then
{Check field values in all fields}
for I := 0 to Table1.FieldCount - 1 do
begin
if Table1.Fields[I].AsString <>
Table2.Fields[I].AsString then
Writeln(F, S + ': '+ Table2.Fields[I].FieldName + ' = '
+ (Table2.Fields[I].AsString));
end
else
{Record must have been deleted from Table2}
Writeln(F, S + ' is NOT found in '+ OpenDialog2.FileName);
Table1.Next;
end;
{Checking for new records added to Table2}
{Goto first record in Table2}
Table2.First;
While not Table2.EOF do
begin
{Put Table1 in SetKey state}
{Note - as no value has been assigned to the IndexName property then
Primary Index is utilised. Delphi always open tables on its
Primary Index.}
Table1.SetKey;
with Table2 do
{Assign Values to be searched for in Table1 using Primary Key}
for I := 0 to IndexFieldCount - 1 do
Table1.Fields[I].AsString := IndexFields[I].AsString;
if not Table1.GotoKey then
begin
Writeln (F,'');
Writeln(F, 'New record found in '+ OpenDialog2.FileName
+' with these values:');
for I := 0 to Table2.FieldCount - 1 do
Writeln(F, Table2.Fields[I].FieldName + ' = '
+ (Table2.Fields[I].AsString));
end;
Table2.Next;
end;
{Tidy up}
CloseFile(F);
Table1.First;
Table2.First;
{Open Scanlog.txt using NOTEPAD.EXE}
WinExec('NOTEPAD.EXE Scanlog.txt',SW_SHOWNORMAL);
EXCEPT
on EDatabaseError do
begin
MessageDlg('Problem detected when examining data tables.',
mtError, [mbOk], 0);
{Tidy up}
CloseFile(F);
Table1.First;
Table2.First;
end;
on EDBEngineError do
begin
MessageDlg('Problem detected when examining data tables.',
mtError, [mbOk], 0);
{Tidy up}
CloseFile(F);
Table1.First;
Table2.First;
end;
END;
END;
procedure TMain.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
Table1.Active := False; {Ensure existing selection is deactivated}
Label1.Caption := OpenDialog1.FileName;
Table1.TableName := OpenDialog1.FileName;
Table1.Active := True;
end;
end;
procedure TMain.SpeedButton2Click(Sender: TObject);
begin
if OpenDialog2.Execute then
begin
Table2.Active := False; {Ensure existing selection is deactivated}
Label2.Caption := OpenDialog2.FileName;
Table2.TableName := OpenDialog2.FileName;
Table2.Active := True;
end;
end;
procedure TMain.DBGrid1Enter(Sender: TObject);
begin
{Assign DBNavigator to DataSource looking at Table1}
DBNavigator1.DataSource := DataSource1;
end;
procedure TMain.DBGrid2Enter(Sender: TObject);
begin
{Assign DBNavigator to DataSource looking at Table2}
DBNavigator1.DataSource := DataSource2;
end;
procedure TMain.BitBtn2Click(Sender: TObject);
begin
{Disable datasets}
Table1.Active := False;
Table2.Active := False;
{Change captions}
Label1.Caption := 'Select table';
Label2.Caption := 'Select table';
end;
procedure TMain.SpeedCloseClick(Sender: TObject);
begin
{Close program}
Close;
end;
procedure TMain.SpeedHelpClick(Sender: TObject);
begin
{Ensure that the TabbedNotebook is displaying the first tab}
ScanHelp.TabbedNotebook1.PageIndex := 0;
ScanHelp.ShowModal;
end;
procedure TMain.About1Click(Sender: TObject);
begin
{Show incredible AboutBox for massive EGO boost!}
AboutBox.ShowModal;
end;
end.